
# Estimating the persistence of party cue effects in a panel survey experiment

# ATTRITION ANALYSIS FILE ####

library(tidyverse)
library(cowplot)
library(broom)
library(papaja)

set.seed(42)

# Load in the data
df <- read_rds("data_odc.rds")

# Analyze attrition during initial survey (t0) ####

# Count people who started t0
n_t0_started <- length(unique(df$pid))

# Count people who completed t0
n_t0_finished <-
  df %>% 
  filter(finished.t0 == 1) %>% 
  distinct(pid) %>% 
  nrow()

# Count people who started but did not complete t0
n_t0_started - n_t0_finished

# Count people who completed t0 but did not start nor complete follow-up (t1)
n_lost_t0_t1 <- 
  df %>% 
  filter(finished.t0 == 1, finished.t1 == 0 | is.na(finished.t1)) %>% 
  distinct(pid) %>% 
  nrow()

# Proportion completing t1 after completing t0
1 - (n_lost_t0_t1 / n_t0_finished) 

# Create new variables for post-treatment drop out
# Continue check is the last pre-treatment question and is forced choice - if missing, dropout is pre-treatment
df <- 
  df %>% 
  mutate(
    # Post-treatment dropout in initial survey
    t0_drop_post_treat = case_when(finished.t0 == 0 & !is.na(continue_check.t0) ~ 1, TRUE ~ 0),
    # Dropout between survey waves     
    lost_to_follow_up  = case_when(finished.t0 == 1 & finished.t1 == 0 ~ 1, 
                                   finished.t0 == 1 & is.na(finished.t1) ~ 1,
                                   finished.t0 == 0 ~ NA_real_,
                                   TRUE ~ 0)) %>% 
  # Code all post-treatment dropouts
  mutate(drop_post_treat = case_when(t0_drop_post_treat == 1 | lost_to_follow_up == 1 ~ 1,
                                     is.na(continue_check.t0) ~ NA_real_, # pre-treatment dropouts get assigned NA
                                     TRUE ~ 0))

# Count total post-treatment dropout
df %>% 
  distinct(pid, .keep_all = T) %>% 
  count(drop_post_treat)

# Test whether random assignment to party cue on any issue predicts dropout
mod_drop_post_treat_by_cue <-
  df %>% 
  group_by(item_index) %>% 
  do(tidy(glm(drop_post_treat ~ cue, data = ., family = "binomial"))) %>% 
  ungroup() %>% 
  mutate(p.value = printp(p.value)) %>% 
  mutate_if(is.numeric, ~round(., 2)) %>%
  filter(term == "cue") %>% 
  rename(predictor = term)

saveRDS(mod_drop_post_treat_by_cue, "table_A2.rds") # Table A2

# Raw numbers for foreign aid issue (Table A3)
df %>% 
  filter(item_index == "Foreign aid") %>% 
  group_by(drop_post_treat, cue) %>% 
  count() %>%
  drop_na(drop_post_treat) %>% 
  rename(`Post-treatment dropout` = drop_post_treat) %>% 
  saveRDS("table_A3.rds")

# Test whether random assignment to t1_only predicts dropout (Table A6)
mod_drop_post_treat_by_condition <-
  tidy(glm(drop_post_treat ~ t1_only,
           data = df %>% distinct(pid, .keep_all = T), 
           family = "binomial")) %>% 
  mutate(p.value = printp(p.value)) %>% 
  mutate_if(is.numeric, ~round(., 2)) %>% 
  filter(term == "t1_only") %>% 
  rename(predictor = term)

saveRDS(mod_drop_post_treat_by_condition, "table_A6.rds")

# Test whether post-treatment dropout predicts pre-treatment covariates

# List of covariates
covs <- list("female", "college", "democrat", "party_strength", "liberal", "ideo_strength", "biden2020")

# Fit models
# mod_covariate_dropout <-
#   map(covs, 
#       ~tidy(lm(get(.x) ~ drop_post_treat,
#                data = df %>% distinct(pid, .keep_all = T)))) %>% 
#   bind_rows() %>% 
#   filter(term == "drop_post_treat") %>% 
#   mutate(covariate_outcome = unlist(covs),
#          p.value = printp(p.value)) %>% 
#   mutate_if(is.numeric, ~round(., 4)) %>% 
#   rename(predictor = term) %>% 
#   mutate(predictor = "Post-treatment dropout",
#          covariate_outcome = case_when(covariate_outcome == "ideo_strength" ~ "ideological extremity",
#                                        covariate_outcome == "party_strength" ~ "strength of party ID",
#                                        TRUE ~ covariate_outcome))

#saveRDS(mod_covariate_dropout, "attrition_predict_covariates.rds")

# Correlations between foreign aid policy opinion (recoded) and pre-treatment covariates

# At initial survey (Table A4)
map(covs,
    ~tidy(lm(get(.x) ~ outcome.t0_recode,
             data = df %>% filter(item_index == "Foreign aid")))) %>% 
  bind_rows() %>% 
  filter(term != "(Intercept)") %>% 
  mutate(covariate_outcome = unlist(covs),
         p.value = printp(p.value)) %>% 
  mutate_if(is.numeric, ~round(., 4)) %>% 
  rename(predictor = term) %>% 
  mutate(predictor = "t0 policy opinions (recoded)",
         covariate_outcome = case_when(covariate_outcome == "ideo_strength" ~ "ideological extremity",
                                       covariate_outcome == "party_strength" ~ "strength of party ID",
                                       TRUE ~ covariate_outcome)) %>% 
  saveRDS("table_A4.rds")

# At follow-up survey (Table A5)
map(covs,
    ~tidy(lm(get(.x) ~ outcome.t1_recode,
             data = df %>% filter(item_index == "Foreign aid")))) %>% 
  bind_rows() %>% 
  filter(term != "(Intercept)") %>% 
  mutate(covariate_outcome = unlist(covs),
         p.value = printp(p.value)) %>% 
  mutate_if(is.numeric, ~round(., 4)) %>% 
  rename(predictor = term) %>% 
  mutate(predictor = "t1 policy opinions (recoded)",
         covariate_outcome = case_when(covariate_outcome == "ideo_strength" ~ "ideological extremity",
                                       covariate_outcome == "party_strength" ~ "strength of party ID",
                                       TRUE ~ covariate_outcome)) %>% 
  saveRDS("table_A5.rds")

